home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / e / amigae21b.lha / Amiga_E_v2.1b / Sources / Other / Calc.e < prev    next >
Text File  |  1992-09-02  |  5KB  |  249 lines
  1. /**********************************/
  2. /* A tiny calculator written in E */
  3. /* By EA van Breemen             */
  4. /**********************************/
  5.  
  6. CONST DIV_BY_ZERO=1
  7. CONST NOT_IMPLEMENTED=2
  8. CONST RIGHT_MISSING=3
  9. CONST UNKOWN_FUNCTION=4
  10. CONST OVER_FLOW=5
  11.  
  12.  
  13. DEF stoppen,err
  14. DEF buffer[256]:STRING
  15. DEF line:PTR TO CHAR
  16. DEF answer,result
  17. DEF x_value
  18.  
  19. PROC main()
  20.   WriteF('E Calculator v1.0\nCopyright by Van Breemen Software \c1993\n',169)
  21.   WriteF('Written by EA van Breemen.\n')
  22.   stoppen:=FALSE
  23.   answer:=0
  24.   x_value:=0
  25.   WHILE (stoppen=FALSE)
  26.     err:=FALSE
  27.     getline()
  28.     process()
  29.   ENDWHILE
  30.   WriteF('\nBy your command\n')
  31. ENDPROC
  32.  
  33. PROC error(no)
  34.   DEF i
  35.   IF err=TRUE THEN RETURN
  36.   WriteF('=>')
  37.   FOR i:=0 TO (line-buffer-1) DO WriteF(' ')
  38.   WriteF('^\n')
  39.   err:=TRUE
  40.   WriteF('=>Error \d:',no)
  41.   SELECT no
  42.     CASE DIV_BY_ZERO
  43.       WriteF('Division by zero')
  44.     CASE RIGHT_MISSING
  45.       WriteF('Right ) missing')
  46.     CASE UNKOWN_FUNCTION
  47.       WriteF('Unkown function')
  48.     CASE OVER_FLOW
  49.       WriteF('Number too large or overflow')
  50.     CASE NOT_IMPLEMENTED
  51.       WriteF('Not implimented')
  52.   ENDSELECT
  53.   WriteF('\n') 
  54. ENDPROC
  55.  
  56. PROC getline()
  57.   DEF ok
  58.   WriteF('=>')
  59.   ok:=ReadStr(stdout,buffer)
  60.   LowerStr(buffer)            /* make everything lowercase */
  61.   line:=TrimStr(buffer)
  62. ENDPROC
  63.  
  64. PROC process()
  65.   DEF a
  66.   a:=getchar()
  67.   SELECT a
  68.     CASE 10
  69.       RETURN
  70.     CASE "q"
  71.       stoppen:=TRUE
  72.       RETURN
  73.     CASE "h"
  74.       help()
  75.       RETURN
  76.     CASE "x"
  77.       IF get_x() THEN err:=TRUE ELSE answer:=readexpression()
  78.     DEFAULT
  79.       answer:=readexpression()
  80.   ENDSELECT
  81.   IF err=FALSE
  82.     result:=answer
  83.     WriteF('=>\d\n',answer)
  84.   ENDIF
  85. ENDPROC
  86.  
  87. PROC getchar()
  88.   DEF ch
  89.   ch:=line[0]
  90.   WHILE ((ch=" ") AND (StrLen(line)>0)) 
  91.     line++
  92.     ch:=line[0]
  93.   ENDWHILE
  94.   RETURN IF (ch<>" ") AND (StrLen(line)>0) THEN ch ELSE 10
  95. ENDPROC
  96.  
  97. PROC help()
  98.   WriteF('=>Help on the E calculator\n')
  99.   WriteF('=>By EA van Breemen\n')
  100.   WriteF('=>\n=>Enter an algebraic expression and press ENTER\n')
  101.   WriteF('=>The following functions are available:\n')
  102.   WriteF('=> + - * / ^\n')
  103.   WriteF('=> abs()\n')
  104.   WriteF('=>\n=>variable x may be used in the equations.\n')
  105.   WriteF('=>The last computation result is stored in ans.\n')
  106.   WriteF('=>Use q to quit.\n')
  107.   WriteF('=>Note: * / and ^ have the same computation priority.\n')
  108. ENDPROC
  109.  
  110.  
  111. PROC readexpression()
  112.   DEF exprvalue,nextterm,operator,ch
  113.   exprvalue:=readterm()
  114.   ch:=getchar()
  115.   WHILE (ch="+") OR (ch="-")
  116.     operator:=IF (ch="+") THEN 1 ELSE -1
  117.     line++
  118.     nextterm:=readterm()
  119.     exprvalue:=IF operator=1 THEN exprvalue+nextterm ELSE exprvalue-nextterm
  120.     ch:=getchar()
  121.   ENDWHILE
  122. ENDPROC exprvalue
  123.  
  124.  
  125. PROC readterm()
  126.   DEF termvalue,nextvalue,mult,i
  127.   DEF ch,operator
  128.   termvalue:=readfactor()
  129.   ch:=getchar()
  130.   WHILE (ch="/") OR (ch="*") OR (ch="^")
  131.      operator:=ch
  132.      line++
  133.      nextvalue:=readfactor()
  134.      SELECT operator
  135.        CASE "*"
  136.          termvalue:=Mul(termvalue,nextvalue)
  137.        CASE "/"
  138.          IF (nextvalue<>0)
  139.            termvalue:=Div(termvalue,nextvalue)
  140.          ELSE
  141.            error(DIV_BY_ZERO)
  142.          ENDIF
  143.        CASE "^"
  144.          IF nextvalue=0 
  145.            termvalue:=1
  146.          ELSE
  147.            mult:=termvalue
  148.            IF nextvalue<0
  149.              error(NOT_IMPLEMENTED)
  150.              termvalue:=1
  151.            ENDIF
  152.            FOR i:=1 TO nextvalue-1 DO termvalue:=Mul(termvalue,mult)
  153.          ENDIF
  154.      ENDSELECT
  155.      ch:=getchar()
  156.   ENDWHILE
  157. ENDPROC termvalue
  158.  
  159. PROC readfactor()
  160.   DEF factorvalue,ch
  161.   ch:=getchar()
  162.   IF (ch="-")
  163.     line++
  164.     RETURN Mul(-1,readfactor())  /* read - recursivly */
  165.   ENDIF
  166.   IF (ch="+")
  167.     line++
  168.     RETURN readfactor()
  169.   ENDIF
  170.   IF ((ch>="0") AND (ch<="9")) OR (ch="x") OR (ch=".")
  171.     factorvalue:=readnumber()
  172.   ELSE
  173.     IF (ch="(")
  174.       line++
  175.       factorvalue:=readexpression()
  176.       ch:=getchar()
  177.       IF (ch=")")
  178.         line++
  179.         ch:=getchar()
  180.       ELSE
  181.         error(RIGHT_MISSING)
  182.       ENDIF
  183.     ELSE
  184.       factorvalue:=try_functions()
  185.     ENDIF
  186.   ENDIF
  187. ENDPROC factorvalue
  188.  
  189.  
  190. PROC readnumber()
  191.   DEF numvalue,oldnumvalue,ch
  192.   numvalue:=0
  193.   oldnumvalue:=0
  194.   ch:=getchar()
  195.   IF (ch="x")
  196.     line++
  197.     RETURN x_value
  198.   ENDIF
  199.   WHILE (ch>="0") AND (ch<="9")
  200.     numvalue:=Mul(10,numvalue)+ch-"0"
  201.     line++
  202.     ch:=getchar()
  203.     IF Div(numvalue,10)<>oldnumvalue
  204.       error(OVER_FLOW)
  205.       RETURN 0
  206.     ELSE
  207.       oldnumvalue:=numvalue
  208.     ENDIF
  209.   ENDWHILE  
  210. ENDPROC numvalue
  211.  
  212. PROC try_functions()
  213.   DEF oldline:PTR TO CHAR
  214.   DEF ch1,ch2,ch3
  215.   DEF answer
  216.   oldline:=line
  217.   ch1:=getchar()
  218.   line++
  219.   ch2:=getchar()
  220.   line++
  221.   ch3:=getchar()
  222.   line++
  223.   IF (ch1="a") AND (ch2="b") AND (ch3="s")
  224.     answer:=readexpression();
  225.     RETURN Abs(answer)
  226.   ENDIF
  227.   IF (ch1="a") AND (ch2="n") AND (ch3="s")
  228.     RETURN result
  229.   ENDIF
  230.   error(UNKOWN_FUNCTION)
  231. ENDPROC
  232.  
  233. PROC get_x()
  234.   DEF ch
  235.   DEF oldline:PTR TO CHAR
  236.   oldline:=line
  237.   line++
  238.   ch:=getchar()
  239.   IF ch<>"="
  240.     line:=oldline
  241.     RETURN FALSE
  242.   ELSE
  243.     line++
  244.     ch:=getchar()
  245.     x_value:=readexpression()
  246.     err:=TRUE
  247.   ENDIF
  248. ENDPROC TRUE
  249.